home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / tool+ / textEdit < prev    next >
Encoding:
Text File  |  1994-11-29  |  3.9 KB  |  127 lines  |  [TEXT/YERK]
  1. \ textEdit class based on bjr 1987
  2. \ 12.11.89    rfl now subclass of handle
  3. \ A lot of these methods leave the current font of the window changed.
  4. \ 4.17.91    rfl fixed rect1...actually should move into rect
  5. \ 4.23.91    rfl    added addText:
  6. \ 10.14.92    rfl    added scrap handing stuff
  7. \ 10.18.91    rfl    protect for 32k limit
  8. \ 2.22.94    rfl    added autoView
  9. \ 9.28.94    rfl    changed rsrc string number on new:
  10. \ 10.8.94    rfl    added shift? to click: method; changed highlight: to selectAll:
  11.  
  12. $ 7fff value teLimit
  13.  
  14. string teScrap
  15.  
  16. : !TeScrap global TEScrpHandle @ teScrap ! ;
  17. \ words to get and put the text edit scrap
  18. : GetTeScrap ( -- addr len) !TeScrap get: teScrap ;
  19. : putTeScrap ( addr len --) !TeScrap put: teScrap size: teScrap global teScrpLength w! ;
  20. : teScrap>Scrap call zeroScrap !TeScrap lock: teScrap 0 size: teScrap TxType ptr: teScrap
  21.         +base call putScrap drop unlock: teScrap ;
  22. : scrap>teScrap  getScrap drop lock: parmstr get: parmstr putTeScrap unlock: parmstr ;
  23.  
  24.  
  25. \ : GetTeScrap ( -- addr len) global TEScrpHandle @ >ptr global TEScrpLength w@ ;
  26. \ 
  27. \ : PutTeScrap { addr len \ temp -- } len global TEScrpLength w! global TeScrpHandle @
  28. \         heap> string -> temp temp ! addr len put: temp dispose> temp ;
  29. \ 
  30. \ \ put the text edit scrap into the scrap
  31. \ : teScrap>Scrap { \ addr len -- } call zeroScrap getTeScrap -> len -> addr
  32. \         0 len TxType addr +base call putScrap drop ;
  33. \ \ scrap to text edit scrap
  34. \ : scrap>teScrap  getScrap drop lock: parmstr get: parmstr putTeScrap unlock: parmstr ;
  35.  
  36. :CLASS TextEdit <Super handle
  37.  
  38.     Rect ViewRect        \ as in IM V1
  39.     Rect DestRect        \ ditto
  40.  
  41.   :M  PtIn: ( -- b) where: theMouse pack ptIn: viewrect ;M 
  42.   :M  TEString: ( addr len  -- AbsAddr Length) swap +Base swap ;M
  43.   
  44.   \ first set up rects
  45.   :M  New: { myWind  -- }
  46.         alive: myWind not classerr" 192
  47.         PushPort set: myWind
  48.         0 Abs: DestRect Abs: ViewRect Call TENew m!
  49.         PopPort ;M
  50.  
  51.   :M  alive: ( -- b) m@ 0 <> ;M
  52.  
  53.   :M  close: m@ -dup IF Call TEDispose 0 m! THEN ;M
  54.   
  55.   :M  justify: ( Just --) MakeInt m@ Call TESetJust ;M
  56.   
  57.   :M  SetSelect: ( Start End --) m@ Call TESetSelect ;M
  58.   
  59.   :M  selectAll: 0 $ 7fff setSelect: self ;M
  60.  
  61.   :M  hilite: selectAll: self ;M
  62.  
  63.   :M  moveTo: ( Position --) Dup SetSelect: Self ;M
  64.   
  65.   :M  Activate: m@ Call TEActivate ;M
  66.   
  67.   :M  Deactivate: m@ Call TEDeactivate ;M
  68.  
  69.   :M  teCut: m@ Call TECut ;M
  70.   
  71.   :M  teCopy: m@ Call TECopy ;M
  72.   
  73.   :M  tePaste: m@ Call TEPaste ;M
  74.  
  75.   :M  teDelete: m@ Call TEDelete ;M
  76.  
  77.   :M  PutText: ( addr len --) TEString: Self m@ Call TESetText ;M
  78.   
  79.   :M  GetText: ( -- addr len)
  80.         0 m@ Call TEGetText >ptr ptr: self 60 + w@  ;M
  81.  
  82.   :M  ReCal: m@ call TECalText ;M
  83.  
  84.   :M  textSize: ( -- len) getText: self swap drop ;M
  85.   
  86.   :M  overLimit?: ( len -- len b) dup textSize: self + teLimit > ;M
  87.  
  88.   :M  clear: 0 textSize: self setSelect: self TEDelete: self ;M
  89.   
  90.   :M  Insert: ( addr len --) TEString: Self m@ Call TEInsert ;M
  91.   
  92.   :M  Key: ( char --) MakeInt m@ Call TEKey ;M
  93.   
  94. \ could change teDelete to TeCut to do something with top of text
  95. \ for right now, delete twice the new addition and creep up to top again
  96.   :M  AddText: ( addr len --) overLimit?: self
  97.         IF 0 over 2* setSelect: self teDelete: self
  98.         THEN
  99.         textSize: self 1+ moveto: self insert: self ;M
  100.  
  101.   :M  Draw: clear: destRect
  102.         Abs: destRect m@ Call TEUpdate ;M
  103.   
  104.   :M  print:  abs: destRect m@ call TEUpdate ;M
  105.   
  106.   :M  Scroll: ( dh dv--)    pack m@ Call TEScroll ;M
  107.  
  108.   :M  Click: where: themouse pack shift? Bool m@ Call TEClick ;M
  109.   
  110.   :M  Idle: m@ Call TEIdle ;M
  111.   
  112.   :M  PutRect: ( l t r b --) put: viewRect  get: viewRect put: destRect
  113.         m@ IF get: destRect ptr: self put: rect
  114.               get: viewRect ptr: self 8+ put: rect
  115.             THEN ;M
  116.  
  117.   :M  ChangeRect: get: destRect ptr: self put: rect get: viewRect ptr: self 8+ put: rect ;M
  118.   
  119.   :M  OffSet: { dx dy -- }
  120.         dx dy OffSet: viewRect get: viewRect put: destRect ;M
  121.   
  122.   :M  InsetDest: ( dx dy --) Inset: DestRect ;M
  123.  
  124.   :M  autoView: ( b --) bool m@ call teAutoView ;M
  125.  
  126. ;CLASS
  127.